home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / PSETUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.5 KB  |  132 lines
  1. { psetup.pas -- Demonstrate Printer setup dialog }
  2.  
  3. program PSetup;
  4.  
  5. {$R psetup.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, Strings, UPrint;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;    { Menu resource ID }
  12.   cm_Setup = 101;    { Menu:Printer setup... command ID }
  13.   cm_Quit  = 102;    { Menu:Exit command ID }
  14.  
  15. type
  16.  
  17.   PSetupApplication = object(TApplication)
  18.     procedure InitMainWindow; virtual;
  19.   end;
  20.  
  21.   PPSetupWindow = ^PSetupWindow;
  22.   PSetupWindow = object(TWindow)
  23.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  24.     procedure CMSetup(var Msg: TMessage);
  25.       virtual cm_First + cm_Setup;
  26.     procedure CMQuit(var Msg: TMessage);
  27.       virtual cm_First + cm_Quit;
  28.   end;
  29.  
  30.   TDeviceMode = procedure(HWindow: HWnd; Module: THandle;
  31.     DeviceName, OutputName: PChar);
  32.  
  33.   TExtDeviceMode =
  34.     function(HWindow: HWnd; HDriver: THandle; DevModeOutput: PDevMode;
  35.       DeviceName, OutputName: PChar; DevModeInput: PDevMode;
  36.       Profile: PChar; Mode: Word): Integer;
  37.  
  38.  
  39. { PSetupApplication }
  40.  
  41. {- Initialize PSetupApplication object's window }
  42. procedure PSetupApplication.InitMainWindow;
  43. begin
  44.   MainWindow := New(PPSetupWindow, Init(nil, 'PSetup'))
  45. end;
  46.  
  47.  
  48. { PSetupWindow }
  49.  
  50. {- Construct PSetupWindow object }
  51. constructor PSetupWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  52. begin
  53.   TWindow.Init(AParent, ATitle);
  54.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  55. end;
  56.  
  57. var
  58.   ExtDeviceMode: TExtDeviceMode;
  59.   DeviceMode: TDeviceMode;
  60.  
  61. {- Execute Menu:Printer setup... command }
  62. procedure PSetupWindow.CMSetup(var Msg: TMessage);
  63. var
  64.   HDriver: THandle;
  65.   Size: Integer; { Size of DevMode structure }
  66.   DeviceName, DriverName, OutputName: PChar;
  67.   DriverExtName: array[0 .. 12] of Char;
  68.   Buffer: array[0 .. 80] of Char;
  69.   DevModeOutput: PDevMode;
  70.   P: TFarProc;
  71. begin
  72.   GetProfileString('windows', 'device', ',,', Buffer, Sizeof(Buffer));
  73.   DeviceName := NextToken(Buffer, ',');
  74.   DriverName := NextToken(nil, ',');
  75.   OutputName := NextToken(nil, ',');
  76.   if (StrLen(DeviceName) = 0) or
  77.      (StrLen(DriverName) = 0) or (StrLen(OutputName) = 0) then
  78.   begin
  79.     MessageBox(HWindow, 'No printer installed', 'Error', mb_Ok);
  80.     Exit
  81.   end;
  82.   StrLCat(StrCopy(DriverExtName, DriverName), '.DRV', 12);
  83.   HDriver := LoadLibrary(DriverExtName);
  84.   if HDriver < 32 then
  85.     MessageBox(HWindow, 'Failed to load driver', 'Error',
  86.       mb_IconExclamation or mb_Ok)
  87.   else begin
  88.     P := GetProcAddress(HDriver, 'ExtDeviceMode');
  89.     if P <> nil then
  90.     begin
  91.       ExtDeviceMode := TExtDeviceMode(P);
  92.       Size := ExtDeviceMode(HWindow, HDriver, nil, DeviceName,
  93.         OutputName, nil, nil, 0);
  94.       GetMem(DevModeOutput, Size);
  95.       ExtDeviceMode(HWindow, HDriver, DevModeOutput, DeviceName,
  96.         OutputName, nil, nil, dm_Prompt or dm_Copy);
  97.       FreeMem(DevModeOutput, Size)
  98.     end else
  99.     begin
  100.       P := GetProcAddress(HDriver, 'DeviceMode');
  101.       if P <> nil then
  102.       begin
  103.         DeviceMode := TDeviceMode(P);
  104.         DeviceMode(HWindow, HDriver, DeviceName, OutputName)
  105.       end
  106.     end;
  107.     FreeLibrary(HDriver)
  108.   end;
  109. end;
  110.  
  111. {- Execute Menu:Exit command }
  112. procedure PSetupWindow.CMQuit(var Msg: TMessage);
  113. begin
  114.   CloseWindow
  115. end;
  116.  
  117. var
  118.  
  119.   PSetupApp: PSetupApplication;
  120.  
  121. begin
  122.   PSetupApp.Init('PSetupApp');
  123.   PSetupApp.Run;
  124.   PSetupApp.Done
  125. end.
  126.  
  127.  
  128. {--------------------------------------------------------------
  129.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  130.   Revision 1.00    Date: 5/22/1991
  131. ---------------------------------------------------------------}
  132.